home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / utility / 540 / toy_cad / uncrunch.lst < prev   
File List  |  1985-11-19  |  4KB  |  215 lines
  1. '      ---------                                                 ---------
  2. ' --------------------     Toy Cad  Picture Uncruncher     --------------------
  3. '   -------------------                                   -------------------
  4. '
  5. DEFBYT "b"
  6. DEFWRD "w"
  7. DEFINT "i"
  8. DEFFLT "r"
  9. '
  10. DEFMOUSE 0
  11. '
  12. mode%=XBIOS(4)
  13. IF mode%<>0
  14.   ALERT 3,"|This demo operates in|    low rez only",0,"Exit",e%
  15.   END
  16. ENDIF
  17. '
  18. HIDEM
  19. '
  20. GOSUB initialize_screens
  21. '
  22. ON ERROR GOSUB fix
  23. ON BREAK GOSUB fix
  24. '
  25. GOSUB define_3d_files
  26. '
  27. GOSUB load_crunched_animation
  28. '
  29. GOSUB show_crunch
  30. '
  31. GOSUB fix
  32. '
  33. '
  34. '
  35. > PROCEDURE show_crunch
  36.   '
  37.   CLS
  38.   COLOR b_white
  39.   '
  40.   IF w_index(0)<>0
  41.     '
  42.     w_start=0
  43.     w_end=w_index(0)-1
  44.     '
  45.     GOSUB draw_crunch
  46.     SGET backdrop$
  47.   ENDIF
  48.   '
  49.   FOR w_frame=1 TO w_crunch_to-w_crunch_from+1
  50.     '
  51.     w_start=w_index(w_frame-1)
  52.     w_end=w_index(w_frame)-1
  53.     '
  54.     GOSUB draw_crunch
  55.     '
  56.     '    GOSUB flip_screen
  57.   NEXT w_frame
  58.   '
  59.   REPEAT
  60.     MOUSE w,w,btn
  61.   UNTIL btn<>0
  62. RETURN
  63. '
  64. > PROCEDURE draw_crunch
  65.   '
  66.   FOR w=w_start TO w_end
  67.     '
  68.     w_x_tri_0=w_crunch_x1(w)
  69.     w_x_tri_1=w_crunch_x2(w)
  70.     w_x_tri_2=w_crunch_x3(w)
  71.     w_x_tri_3=w_x_tri_0
  72.     w_y_tri_0=w_crunch_y1(w)
  73.     w_y_tri_1=w_crunch_y2(w)
  74.     w_y_tri_2=w_crunch_y3(w)
  75.     w_y_tri_3=w_y_tri_0
  76.     '
  77.     b=b_crunch_colors_and_lines(w)
  78.     DEFFILL b AND 15
  79.     POLYFILL 4,w_x_tri(),w_y_tri()
  80.     '
  81.     b=(b AND 240)/16
  82.     IF b<>5
  83.       POLYLINE b+1,w_x_tri(),w_y_tri()
  84.     ENDIF
  85.   NEXT w
  86. RETURN
  87. '
  88. > PROCEDURE initialize_screens
  89.   '
  90.   LOCAL b,br,bc,b2,wt
  91.   '
  92.   DIM ps%(2),ls%(2),br(2)
  93.   '
  94.   ls%=XBIOS(3)
  95.   ps%=XBIOS(2)
  96.   ls%(0)=ls%
  97.   ps%(1)=ps%
  98.   '
  99.   scr$=SPACE$(32000+300)
  100.   ls%(1)=(INT((VARPTR(scr$)+6)/256)+1)*256
  101.   ps%(0)=ls%(1)
  102.   '
  103.   DEFFILL 0
  104.   i=XBIOS(5,L:ps%(0),L:ls%(0),mode%)
  105.   VSYNC
  106.   PBOX 0,0,319,199
  107.   i=XBIOS(5,L:ps%(1),L:ls%(0),mode%)
  108.   VSYNC
  109.   PBOX 0,0,319,199
  110.   '
  111.   b_num_screens=2
  112. RETURN
  113. '
  114. > PROCEDURE home_screen
  115.   '
  116.   i=XBIOS(5,L:ps%,L:ls%,-1)
  117. RETURN
  118. '
  119. > PROCEDURE flip_screen
  120.   b_flip=1-b_flip
  121.   VSYNC
  122.   i=XBIOS(5,L:ps%(b_flip),L:ls%(b_flip),-1)
  123.   VSYNC
  124. RETURN
  125. '
  126. > PROCEDURE load_crunched_animation
  127.   '
  128.   FILESELECT #"load crunch","A:*.crn","",file_name$
  129.   IF file_name$<>""
  130.     OPEN "i",#1,file_name$
  131.     '
  132.     BGET #1,V:w_neo_pallet(2),32
  133.     '
  134.     byte1=INP(#1)
  135.     byte2=INP(#1)
  136.     w_num_triangles=wrd
  137.     '
  138.     w=w_num_triangles*2+2
  139.     '
  140.     BGET #1,V:w_crunch_x1(0),w
  141.     BGET #1,V:w_crunch_x2(0),w
  142.     BGET #1,V:w_crunch_x3(0),w
  143.     BGET #1,V:w_crunch_y1(0),w
  144.     BGET #1,V:w_crunch_y2(0),w
  145.     BGET #1,V:w_crunch_y3(0),w
  146.     BGET #1,V:b_crunch_colors_and_lines(0),w_num_triangles+1
  147.     '
  148.     b_frame=INP(#1)
  149.     '
  150.     BGET #1,V:w_index(0),b_frame*2+2
  151.     '
  152.     CLOSE #1
  153.     GOSUB update_color_regs
  154.   ENDIF
  155. RETURN
  156. '
  157. > PROCEDURE define_colors
  158.   '
  159.   b_black=0
  160.   b_white=1
  161.   b_blue=2
  162.   b_red=3
  163. RETURN
  164. '
  165. > PROCEDURE update_color_regs
  166.   '
  167.   i=XBIOS(6,L:i_pallet_loc)
  168. RETURN
  169. '
  170. > PROCEDURE define_3d_files
  171.   '
  172.   w_max_crunch=1000
  173.   '
  174.   DIM w_index(101)
  175.   DIM w_crunch_x1(w_max_crunch)
  176.   DIM w_crunch_x2(w_max_crunch)
  177.   DIM w_crunch_x3(w_max_crunch)
  178.   DIM w_crunch_y1(w_max_crunch)
  179.   DIM w_crunch_y2(w_max_crunch)
  180.   DIM w_crunch_y3(w_max_crunch)
  181.   '
  182.   DIM b_crunch_colors_and_lines(w_max_crunch)
  183.   '
  184.   DIM w_neo_pallet(64)
  185.   i_pallet_loc=V:w_neo_pallet(0)+4
  186.   '
  187.   GOSUB define_colors
  188.   '
  189.   DIM w_x_tri(5),w_y_tri(5),w_z_tri(5)
  190.   '
  191.   w_max_possible_points=99
  192.   '
  193.   DIM w_backdrop_num(w_max_possible_points)
  194.   '
  195.   ABSOLUTE w_x_tri_0,V:w_x_tri(0)
  196.   ABSOLUTE w_x_tri_1,V:w_x_tri(1)
  197.   ABSOLUTE w_x_tri_2,V:w_x_tri(2)
  198.   ABSOLUTE w_x_tri_3,V:w_x_tri(3)
  199.   '
  200.   ABSOLUTE w_y_tri_0,V:w_y_tri(0)
  201.   ABSOLUTE w_y_tri_1,V:w_y_tri(1)
  202.   ABSOLUTE w_y_tri_2,V:w_y_tri(2)
  203.   ABSOLUTE w_y_tri_3,V:w_y_tri(3)
  204.   '
  205.   ABSOLUTE byte1,V:wrd
  206.   ABSOLUTE byte2,(V:wrd)+1
  207. RETURN
  208. '
  209. > PROCEDURE fix
  210.   GOSUB home_screen
  211.   ON BREAK
  212.   SHOWM
  213.   EDIT
  214. RETURN
  215.